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-- ListPub.mesa; modified by Bruce, September 2, 1978 2:03 PM 

DIRECTORY 

AltoDefs: FROM "altodefs" USING [PageNumber, BytesPerPage] , 
AltoFileDefs: FROM "altoFiledef s" USING [FP], 

CommanderDef s: FROM "commanderdef s" USING [AddCommand, CommandBlockHandle] , 
DirectoryDefs: FROM "directorydef s" USING [DirectoryLookup], 
DisplayDefs: FROM "displaydef s" USING [DisplayOn, DisplayOff], 
GPsortDefs: FROM "gpsortdefs" USING [PutProcType, 

GetProcType, LT, EQ, GT, Sort], 
InlineDefs: FROM "inl inedefs" USING [BITXOR], 
IODefs: FROM "iodefs" USING [CR, Wri teString] , 
ListerDefs: FROM "1 isterdef s M USING [IncorrectVersion, Load, 

Mul tipleModules , NoCode, NoFGT, NoSymbols, PrintSei, SetRoutineSymbols] , 
OutputDefs: FROM "outputdefs" USING [GetOutputStream, CloseOutput, 

OpenOutput, PutChar, PutCR, PutDecimal , PutNumber, PutOctal , PutString], 
SegmentDefs: FROM "segmentdef s" USING [DeleteFileSegment , DestroyFile, 

FileNameError , FileSegmentHandle , LockFile, UnlockFile, Read], 
StreamDefs: FROM "streamdef s M USING [CreateByteStream, DiskHandle, 

Normal izelndex, Getlndex, Grlndex, NewByteStream, Streamlndex] , 
StringDefs: FROM "stringdef s" USING [AppendChar, AppendString, 

AppendSubString, SubStringDescriptor , WordsForString], 
SymbolTableDefs: FROM "symbol tabledef s" USING [ 

AcquireSymbolTable , ReleaseSymbolTable, SymbolTableBase, TableForSegment] , 
SymDefs: FROM "symdefs" USING [BodyRecord, BTIndex, codeANY, codeBOOLEAN, 

codeCHARACTER, codelNTEGER, CTXIndex, HTNull , ISEIndex, ISENull , 1Z, 

recordCSEIndex, recordCSENull , SEIndex, SENull , Transf erMode, typeTYPE]; 

ListPub: PROGRAM 

IMPORTS CommanderDefs, DirectoryDefs, DisplayDefs, GPsortDefs, 

IODefs, ListerDefs, OutputDefs, SegmentDefs, StreamDefs, StringDefs, 

SymbolTableDefs ■ 
BEGIN OPEN SymDefs; 

ProcType: TYPE « PROCEDURE [root: STRING]; 

cz: CHARACTER - 32C; 

FileTooBig: SIGNAL - CODE; 

largestltem: CARDINAL; 

last I tern: StreamDefs .Streamlndex; 

moduleList: STRING <- [40]; 

inSh, outSh, sortSh: StreamDefs .DiskHandle; 

symbols: SymbolTableDefs .SymbolTableBase; 

Cap: PROCEDURE [ch: CHARACTER] RETURNS [cap: CHARACTER] ■ 
BEGIN RETURN[IF ch IN ['a..'z] THEN ch-('a-'A) ELSE ch] END; 

CompareStrings: PROCEDURE [pl,p2: POINTER] RETURNS[INTEGER] - 
BEGIN OPEN GPsortDefs; 
si: STRING «- pi; 
s2: STRING «- p2; 
idx: CARDINAL; 
cl, c2: CHARACTER; 

FOR idx IN [0. .MIN[sl. length, s2. length]) DO 
cl «- Cap[sl[idx]]; c2 <- Cap[s2[idx]]; 
SELECT cl FROM 

< c2 -> RETURN[LT]; 
> c2 «> RETURN[GT]; 
ENDCASE; 
ENDLOOP; 
SELECT si. length FROM 

< s2. length *> RETURN[LT]; 
= s2. length «> RETURN[EQ] 
> s2. length «> RETURN[GT] 
ENDCASE; 
END; 

Getltem: GPsortDefs .GetProcType ■ 
BEGIN 

char: CHARACTER *- 0C; 
s: STRING «- pi; 

st «- [length: 0, maxlength: 1 argestItem-2, text:]; 
UNTIL sortSh.endof[sortSh] DO 

char «- sortSh.get[sortSh]; 

IF char «■ IODefs. CR THEN EXIT ELSE StringDefs. AppendChar[s, char]; 

REPEAT 

FINISHED *> RETURN[0]; 
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ENDLOOP; 
RETURN[StringDefs. Words ForString[s. length]] 
END; 

Putltem: GPsortDef s .PutProcType ■ 
BEGIN OPEN StreamDefs, OutputDefs; 
maxSi: Streamlndex «- Normal izQlndex[[0, 50000]] ; 
trailer: STRING - "13398d2998\b"L; 
namelength: CARDINAL <- 0; 
itemString: STRING «- p; 
PutString[ itemString]; 
PutChar[cz]; 
PutString[trailer]; 
UNTIL itemString[namelength] » ' : DO 

namelength <- namelength+1; 

IF namelength > itemString. length THEN ERROR; 

ENDLOOP; 
PutDecimal[namelength]; PutChar['B]; 
PutCR[]; 

IF GrIndex[GetIndex[outSh],maxSi] THEN SIGNAL FileTooBig; 
END; 

doPriv, xferOnly: BOOLEAN; 

PrintSymbols: PROCEDURE - 

BEGIN OPEN symbols, StringDefs; 
modname: STRING <- [50]; -- :SP[name]SP 
ss: SubStringDescriptor; 
mySei.sei: ISEIndex; 
thisltem: StreamDefs. Streamlndex; 
AppendString[modname, " : ["L]; -- set up modname 

FOR sei <- FirstCtxSe[stHandle.directoryCtx], NextSe[sei] UNTIL sei - ISENull DO 
mySei <- sei ; 
ENDLOOP; 
SubStringForHash[@ss, (seb+mySei) .htptr]; 
AppendSubString[modname,@ss]; 
AppendStr ing[modname, "] "L]; 
AppendSubString[moduleList ,@ss]; 
Bl inkCursor[] ; 
AppendChar[moduleList t ' ]; 

FOR sei <- FirstCtxSe[stHandle.outerCtx], NextSe[sei] UNTIL sei - ISENull DO 
IF (doPriv OR (seb+sei ) . publ ic) AND 

(~xferOnly OR XferMode[(seb+sei ) . idtype] # none) THEN 
BEGIN 

defaultPublic *- TRUE; 
PrintSym[sei , modname]; 
OutputDefs. PutCR[]; 

thisltem <- StreamDefs .GetIndex[outSh] ; 
largestltem <- MAX[largestItem,SiSub[thisItem, lastltem]]; 
lastltem <~ thisltem; 
END; 
ENDLOOP; 
END; 

SiSub: PROCEDURE [sil,si2: StreamDefs .Streamlndex] RETURNS [CARDINAL] - 
BEGIN OPEN AltoDefs; 

pages: PageNumber *- sil.page - si2.page; 
bytes: CARDINAL <- sil.byte - si2.byte; 
RETURN [pages*BytesPerPage+bytes] 
END; 

defaultPublic: BOOLEAN; 

PrintSym: PROCEDURE [sei: ISEIndex, colonstring: STRING] - 
BEGIN OPEN symbols; 
savePublic: BOOLEAN <- defaultPublic; 
typeSei: SEIndex; 
IF (seb+sei). htptr # HTNull THEN 

BEGIN 

Lister Defs . PrintSei[sei] ; 

OutputDefs . PutString[ colons tring] ; 

END; f 
IF (seb+sei) .public ^ defaultPublic THEN 

BEGIN defaultPublic <- (seb+sei ). publ ic; 

OutputDefs. PutString[IF defaultPublic THEN "PUBLIC "L ELSE "PRIVATE "L]; 

END; 
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IF (seb+sei). idtype ■ typoTYPE THEN 
BEGIN typeSei <- (seb+sei) . idinfo; 
OutputDefs. PutString["TYPE«"L]; 
[] <- PrintType[typeSei, NoSub]; 
END 
ELSE 

BEGIN vf: ValFormat; 
typeSei <- (seb+sei ). idtype; 
vf <- PrintType[typeSei , NoSub]; 
IF (seb+sei) .constant AND vf # none THEN 
BEGIN OPEN OutputDefs; 
val: UNSPECIFIED - (seb+sei) . idvalue ; 
PutChar['-]; 
SELECT vf FROM 

num ■> PrintValue[val]; 

char «> BEGIN PutNumber[val , [8, FALSE, TRUE, 0]] ; PutChar['C] END; 
boo! ■> PutString[IF FALSE - val THEN "FALSE" ELSE "TRUE"]; 
ENDCASE; 
END; 
END; 
defaul tPubl ic <- savePublic; 
END; 

PrintFieldCtx: PROCEDURE [ctx: CTXIndex] - 
BEGIN OPEN symbols, OutputDefs; 
isei: ISEIndex <- FirstCtxSe[ctx]; 
first: BOOLEAN <- TRUE; 

IF isei # ISENull AND (seb+isei) .ctxnum H ctx THEN isei ♦- NextSe[isei] ; 
IF isei ■ ISENull THEN 

BEGIN PutString["NULL"L]; RETURN END; 
PutChar['[]; 
FOR isei <- isei, NextSe[isei] UNTIL isei« ISENull DO 

IF first THEN first ♦- FALSE ELSE PutString[", "L]; 

PrintSym[isei, ": "L]; 

ENDLOOP; 
PutChar[']]; 
END; 

PrintValue: PROCEDURE [value: UNSPECIFIED] - 
BEGIN 
IF LOOPHOLE[value, CARDINAL] < 1000 

THEN OutputDefs.PutDecimal[ value] 

ELSE OutputDefs.PutOctal[ value]; 
END; 

NoSub: PROCEDURE » BEGIN RETURN END; 
arraySub: BOOLEAN «- FALSE; 

ValFormat: TYPE ■ {none, num, char, boo! , machinecode} ; 

PrintType: PROCEDURE [tsei: SEIndex, dosub: PROCEDURE] RETURNS [vf: ValFormat] 
BEGIN OPEN SymDefs, OutputDefs, ListerDefs, symbols; 
vf ♦- none; 

WITH t: (seb+tsei) SELECT FROM 
id «> 

BEGIN OPEN SymDefs; 
printBase: BOOLEAN <- TRUE; 
iflnteger: BOOLEAN 4- FALSE; 
bsei: SEIndex «- tsei; 
DO 

WITH (seb+UnderType[bsei]) SELECT FROM 
basic ■> 
BEGIN 
SELECT code FROM 

codelNTEGER «> BEGIN printBase <- iflnteger; vf *- num END; 
codeBOOLEAN «> vf <- bool ; 
codeCHARACTER »> vf ♦- char; 
ENDCASE; 
EXIT; 
END; 
subrange «> BEGIN bsei «- rangetype; iflnteger ♦- TRUE END; 
ENDCASE «> EXIT; 
ENDLOOP; 
IF printBase OR dosub =» NoSub THEN 
BEGIN 
PrintSai[LOOPHOLE[tse1]]; 
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UNTIL (tsei «- TypeLink[tsei]) ■ SENull DO 
WITH (seb+tsei) SELECT FROM 

id -> BEGIN PutChar[' ]; PrintSei[LOOPIIOLE[tsei]] END; 
ENDCASE; 
ENDLOOP; 
END; 
dosub[]; 
END; 
constructor ■> 

WITH t SELECT FROM 

--basic ■> won't see one, see the id first, 
enumerated ■> 

BEGIN isei: ISEIndex; first: BOOLEAN «- TRUE; 
PutChar['{]; 

FOR isei <- FirstCtxSe[valuectx] , NextSe[isei] UNTIL isei» ISENull DO 
IF first THEN first <- FALSE ELSE PutString[", M L]; 
PrintSei[isei]; 
ENDLOOP; 
PutChar['}]; 
END; 
record ■> 
BEGIN 

IF (ctxb+fieldctx).ctxlevel # 1Z THEN 
BEGIN 

fctx: CTXIndex ■ fieldctx; 
bti: BTIndex <- FIRST[BTIndex] ; 
btlimit: BTIndex ■ bti+stHandle.bodyBlock. size; 
PutString["FRAME [ M ]; 
UNTIL bti ■ btlimit DO 

WITH entry: (bb+bti) SELECT FROM 
Callable -> 
BEGIN 

IF entry. localCtx - fctx THEN 
BEGIN 

PrintSei[entry.id]; PutChar[ ' ]]; 
EXIT 
END; 
bti «- bti + (WITH entry SELECT FROM 

Inner °> SIZE[Inner Callable BodyRecord], 
ENDCASE »> SIZE[Outer Callable BodyRecord]); 
END; 
ENDCASE »> bti «- bti + SIZE[Other BodyRecord]; 
ENDLOOP; 
END 
ELSE 
BEGIN 

IF monitored THEN PutString["MONITORED M L]; 
IF machineDep THEN PutString["MACHINE DEPENDENT ,f L]; 
PutString["RECORD"L]; 
PrintFieldCtx[fieldctx]; 
END; 
END; 
pointer => 
BEGIN 

IF ordered THEN PutString["ORDERED H L]; 
IF basing THEN PutStr ing["BASE M L]; 
PutString["POINTER"L]; 
dosub[] ; 
WITH (seb+UrulerType[pointedtotype]) SELECT FROM 

basic => IF code « SymDef s. codeANY THEN GO TO noprint; 
ENDCASE; 
PutString[ M TO "L]; 

[] <- PrintType[pointedtotype, NoSub]; 
EXITS 

noprint *> NULL; 
END; 
array ■> 
BEGIN 

IF packed THEN PutString[ M PACKED M L]; 
PutString[ M ARRAY "L]; 
arraySub <- TRUE; 

[] +- PrintType[indextype, NoSub]; 
arraySub ♦- FALSE; 
PutString[ n OF U L]; 
[] *- PrintType[componenttype, NoSub]; 
END; 
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arraydesc ■> 
BEGIN 

PutString["DESCRIPTOR FOR M L]; 
[] 4- PrintType[describedType t NoSub]; 
END; 
transfer ■> 
BEGIN 

PutModeName[mode]; 
IF inrecord # recordCSENull THEN 

BEGIN PutChar[' ]; 

PrintFieldCtx[(seb+inrecord).f ieldctx]; 

END; 
IF outrecord # recordCSENull THEN 

BEGIN 

PutString[" RETURNS H L]; 

PrintFieldCtx[(seb+outrecord) . f ieldctx]; 

END; 
END; 
union «> 
BEGIN 

tagtype: SEIndex; 
PutString["SELECT "L]; 
IF -controlled THEN 

IF overlayed THEN PutString["OVERLAID "L] 

ELSE PutString[ M COMPUTED M L] 
ELSE 

BEGIN PrintSei[tagsei]; PutString[": "L] END; 
tagtype <- (seb+tagsei ). idtype; 
IF (seb+tagsei) .public # defaul tPubl ic THEN 

OutputDefs,PutString[IF defaul tPubl ic THEN "PRIVATE M L ELSE "PUBLIC "L]; 
WITH (seb+tagtype) SELECT FROM 

id => [] «- PrintType[tagtype, NoSub]; 

constructor ■> PutChar['*]; 

ENDCASE; 
PutString[" FROM "L]; 

BEGIN isei: ISEIndex; first: BOOLEAN «- TRUE; 
varRec: recordCSEIndex; 
FOR isei <- FirstCtxSe[casectx] , NextSe[isei] UNTIL isei* ISENull DO 

IF first THEN first *- FALSE ELSE PutString[\ "L]; 

PrintSei[isei]; PutString[" *> "L]; 

varRec «- (seb+isei ) . idinfo; 

PrintFieldCtx[(seb+varRec).fieldctx]; 

ENDLOOP; 
PutString[" ENDCASE"L]; 
END; 
END; 
relative «> 
BEGIN 

IF baseType # SENull THEN [] «- PrintType[baseType, NoSub]; 
PutString["RELATIVE "L]; 
[] <- PrintType[offsetType, dosub]; 
END; 
subrange ■> 
BEGIN 

org: INTEGER «- origin; 
size: CARDINAL <~ range; 
doit: PROCEDURE « 

BEGIN 

PutChar['[]; 

PrintValue[org]; 

PutString[".."L]; 

IF arraySub AND size ■ 177777B THEN 

BEGIN PrintValue[org]; PutChar[')] END 

ELSE 

BEGIN PrintValue[org+size]; PutChar[']] END; 

END; 
IF -flexible THEN vf <- Printfype[rangetype , doit]; 
END; 
long ■> 
BEGIN 

PutString["LONG "L]; 
[] <~ PrintType[rangetype, NoSub]; 
END; 
real -> PutString["REAL"L]; 

ENDCASE «> PutString["Send message to, SDSUPPORT"L]; 
ENDCASE; 
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END; 

PutModeName: PROCEDURE[n: TransferMode] - 
BEGIN 
ModePrintName: ARRAY TransferMode OF STRING - ["PROCEDURES, "P0RT M L, 

M SIGNAL"L, "ERROR"L, M PROCESS H L , "PROGRAMS, "N0NE"L]; 
OutputDefs.PutString[ModePrintName[n]] 
END; 

DoSymbols: PROCEDURE [bcdFile: STRING] « 
BEGIN OPEN ListerDefs; 
defs: BOOLEAN <- FALSE; 
sseg: SegmentDefs. FileSegmentHandle; 
BEGIN 

[symbols: sseg] «- Load[bcdFile I 
NoFGT »> RESUME; 

NoCode ■> RESUME; -- language feature 

NoSymbols, IncorrectVersion , Mul tipleModules ■> GOTO badformat; 
SegmentDefs. FileNameError «> GOTO badname]; 
DisplayDefs.DisplayOff [black]; 
symbols «- SymbolTableDefs.AcquireSymbolTable[ 

Symbo 1 Tab leDefs. Tab! eForSegment[ sseg]]; 
SetRoutineSymbol s[ symbols] ; 
PrintSymbols[]; 

Symbo 1 Tab leDefs. Re leaseSymbol Tab! e[symbols]; 
SegmentDefs . DeleteFileSegment[sseg]; 
EXITS 

badformat ■> 

BEGIN OPEN IODefs; 
DisplayDefs.DisplayOn[]; 
WriteString[bcdFile]; 
WriteString[" Has A Bad Format 1"L]; 
END; 
badname ■> 

BEGIN OPEN IODefs; 
DisplayDefs.DisplayOn[]; 
WriteString[ bcdFile]; 
WriteString[ M Not Foundl"L]; 
END; 
END; 
END; -- Of DoSymbols 

AppendBcd: PROCEDURE [s: STRING] - 
BEGIN 

i: CARDINAL; 
FOR i IN [0. .s. length) DO 

IF s[i] - \ THEN BEGIN s. length «- i; EXIT END 

ENDLOOP; 
StringDefs. Appends tring[s, M .bcd"L] ; 
END; 

globalRoot: STRING; 

Dolt: PROCEDURE[root: STRING, myDoPriv, myXferOnly: BOOLEAN] - 
BEGIN OPEN SegmentDefs, OutputDefs; 
list: BOOLEAN; 
bcdFile: STRING <- [40]; 
sortFile: STRING <• M 2.xref M ; 
fp: AltoFileDefs.FP; 

globalRoot *- root; doPriv <- myDoPriv; xferOnly *- myXferOnly; 
StringDefs. AppendString[bcdFile, root]; 
AppendBcd[bcdFile]; 

list *- NOT DirectoryDefs .DirectoryLookup[@fp, bcdFile, FALSE]; 
largestltem ♦- 0; 
lastltem <- [0,0]; 

OutputDefs . OpenOutput[root , M . scratch$"L]; 
outSh ♦- LOOPHOLE[GetOutputStream[]]; 
IF list THEN 

BEGIN OPEN StreamOefs; 

inSh «- NewByteStream[root,Read 1 FileNameError -> GOTO badname]; 

GPsortDefs.Sort[GetNamo,PutName,CompareStrings,22,22,140]; 

PutChar[cz]; PutChar[ ' j] ; PutCR[]; -- trailer for module list 

inSh.destroy[inSh]; 

EXITS 

badname ■> BEGIN IODefs .Wri teString[ M File Not Foundl"L]; RETURN END; 

END 
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ELSE 
BEGIN 

DoSymbols[bcdFile]; 
ChangeOutput[]; 
PutString[moduleList]; 

PutChar[cz]; PutChar['c]; PutCR[]; -- trailer for heading 
END; 
PutChar[cz]; PutCR[]; -- skip a line 
largestltem <- largestltem + 20; -- a little slop 
BlinkCursor[]; 

GPsortDef s. So rt [Get Item, Put I tern, Compares t rings ,100 .largest I tern/ 2, 15 
IFileTooBig -> 
BEGIN 

CloseOutput[]; 
OpenOutput[root,sortFile]; 
outSh <- LOOPHOLE[GetOutputStream[]]; 
sortFile[0] ♦■ sortFile[0] + 1; 
RESUME 
END]; 
DisplayDefs.DisplayOn[]; 
sortSh.destroy[sortSh]; 
UnlockFile[sortSh.file]; 
DestroyFile[sortSh.file]; 
CloseOutput[]; 
END; 

BlinkCursor: PROCEDURE ■ 
BEGIN 

map: POINTER TO WORD « L00PH0LE[431B] ; 
i: CARDINAL; 
FOR i IN [0. .16) DO 

(map+i)t <- InlineDefs.BITXOR[(map+i)t,177777B]; 

ENDLOOP; 
FOR i IN [0..1000) DO NULL ENDLOOP; — wait a little while 
FOR i IN [0. .16) DO 

(map+i)t <- InlineDefs.BITXOR[(map+i)t,177777B]; 

ENDLOOP; 
END; 

ChangeOutput: PROCEDURE ■ 

BEGIN OPEN SegmentDefs, OutputDefs; 

LockFile[outSh.file]; 

CloseOutput[]; 

sortSh «- StreamDefs.CreateByteStream[outSh. file, Read]; 

OpenOutput[globalRoot,'\xref"L]; 

outSh <- LOOPHOLE[GetOutputStream[]]; 

PutString["PUBLIC SYMBOLS FOR W L]; 

END; 

GetName: GPsortDef s.GetProcType a 
BEGIN OPEN StringDefs; 
char: CHARACTER <- 0C; 
file: STRING <- [40]; 
s: STRING «- pi; 

st «- [length: 0, maxlength: 40, text:]; 
UNTIL inSh.endof[inSh] DO 
char <- inSh.get[inSh]; 
SELECT char FROM 

'-, '., '$ «> AppendChar[f ile.char]; 
IN [ f 0..'9] ■> AppendChar[f ile.char]; 
IN ['A..'Z] => AppendChar[f ile.char]; 
IN [^..'z] «> AppendChar[file,char]; 
ENDCASE => IF file. length # THEN EXIT; 
REPEAT 

FINISHED «> 

BEGIN OPEN OutputDefs; 
ChangeOutput[]; 

PutChar[cz]; PutChar['c]; PutCR[]; -- trailer for heading 
RETURN[0]; 
END; 
ENDLOOP; 
AppendBcd[fi1e]; 
DoSymbols[f ile]; 
AppendString[s,moduleList]; 
moduleList. length <- 0; 
RElURN[WordsForString[s.length]] 
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END; 

PutName: GPsortDef s.PutProcType ■ 
BEGIN 

s: STRING «- L00PH0LE[p]; 
OutputDefs.PutString[s]; 
END; 

-- mainline 

command: CommanderDefs.CommandBlockHandle; 



command ♦- CommanderDef s.AddCommand["Xref " , LOOPHOLE[DoIt], 3]; 



command. params 



command. params[l] 



[0] <- [type: string, prompt: "Filename"]; 



command. params 



[2] 



[type: boolean, prompt: "Include Private Symbols?"]; 
[type: boolean, prompt: "Procedures Only?"]; 



END. 



